home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / COMM.SWG / 0045_Fossil Driver.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  5KB  |  262 lines
  1. unit ddfossil;
  2. {$S-,V-,R-}
  3.  
  4. interface
  5. uses dos;
  6.  
  7. const
  8.  name='Fossil drivers for TP 4.0';
  9.  author='Scott Baker';
  10. type
  11.  fossildatatype = record
  12.                    strsize: word;
  13.                    majver: byte;
  14.                    minver: byte;
  15.                    ident: pointer;
  16.                    ibufr: word;
  17.                    ifree: word;
  18.                    obufr: word;
  19.                    ofree: word;
  20.                    swidth: byte;
  21.                    sheight: byte;
  22.                    baud: byte;
  23.                   end;
  24. var
  25.  port_num: integer;
  26.  fossildata: fossildatatype;
  27.  
  28. procedure async_send(ch: char);
  29. procedure async_send_string(s: string);
  30. function async_receive(var ch: char): boolean;
  31. function async_carrier_drop: boolean;
  32. function async_carrier_present: boolean;
  33. function async_buffer_check: boolean;
  34. function async_init_fossil: boolean;
  35. procedure async_deinit_fossil;
  36. procedure async_flush_output;
  37. procedure async_purge_output;
  38. procedure async_purge_input;
  39. procedure async_set_dtr(state: boolean);
  40. procedure async_watchdog_on;
  41. procedure async_watchdog_off;
  42. procedure async_warm_reboot;
  43. procedure async_cold_reboot;
  44. procedure async_Set_baud(n: integer);
  45. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  46. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  47.  
  48. implementation
  49.  
  50. procedure async_send(ch: char);
  51. var
  52.  regs: registers;
  53. begin;
  54.  regs.al:=ord(ch);
  55.  regs.dx:=port_num;
  56.  regs.ah:=1;
  57.  intr($14,regs);
  58. end;
  59.  
  60. procedure async_send_string(s: string);
  61. var
  62.  a: integer;
  63. begin;
  64.  for a:=1 to length(s) do async_send(s[a]);
  65. end;
  66.  
  67. function async_receive(var ch: char): boolean;
  68. var
  69.  regs: registers;
  70. begin;
  71.  ch:=#0;
  72.  regs.ah:=3;
  73.  regs.dx:=port_num;
  74.  intr($14,regs);
  75.  if (regs.ah and 1)=1 then begin;
  76.   regs.ah:=2;
  77.   regs.dx:=port_num;
  78.   intr($14,regs);
  79.   ch:=chr(regs.al);
  80.   async_receive:=true;
  81.  end else async_receive:=false;
  82. end;
  83.  
  84. function async_carrier_drop: boolean;
  85. var
  86.  regs: registers;
  87. begin;
  88.  regs.ah:=3;
  89.  regs.dx:=port_num;
  90.  intr($14,regs);
  91.  if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;
  92. end;
  93.  
  94. function async_carrier_present: boolean;
  95. var
  96.  regs: registers;
  97. begin;
  98.  regs.ah:=3;
  99.  regs.dx:=port_num;
  100.  intr($14,regs);
  101.  if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;
  102. end;
  103.  
  104. function async_buffer_check: boolean;
  105. var
  106.  regs: registers;
  107. begin;
  108.  regs.ah:=3;
  109.  regs.dx:=port_num;
  110.  intr($14,regs);
  111.  if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;
  112. end;
  113.  
  114. function async_init_fossil: boolean;
  115. var
  116.  regs: registers;
  117. begin;
  118.  regs.ah:=4;
  119.  regs.bx:=0;
  120.  regs.dx:=port_num;
  121.  intr($14,regs);
  122.  if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;
  123. end;
  124.  
  125. procedure async_deinit_fossil;
  126. var
  127.  regs: registers;
  128. begin;
  129.  regs.ah:=5;
  130.  regs.dx:=port_num;
  131.  intr($14,regs);
  132. end;
  133.  
  134. procedure async_set_dtr(state: boolean);
  135. var
  136.  regs: registers;
  137. begin;
  138.  regs.ah:=6;
  139.  if state then regs.al:=1 else regs.al:=0;
  140.  regs.dx:=port_num;
  141.  intr($14,regs);
  142. end;
  143.  
  144. procedure async_flush_output;
  145. var
  146.  regs: registers;
  147. begin;
  148.  regs.ah:=8;
  149.  regs.dx:=port_num;
  150.  intr($14,regs);
  151. end;
  152.  
  153. procedure async_purge_output;
  154. var
  155.  regs: registers;
  156. begin;
  157.  regs.ah:=9;
  158.  regs.dx:=port_num;
  159.  intr($14,regs);
  160. end;
  161.  
  162. procedure async_purge_input;
  163. var
  164.  regs: registers;
  165. begin;
  166.  regs.ah:=$0a;
  167.  regs.dx:=port_num;
  168.  intr($14,regs);
  169. end;
  170.  
  171. procedure async_watchdog_on;
  172. var
  173.  regs: registers;
  174. begin;
  175.  regs.ah:=$14;
  176.  regs.al:=01;
  177.  regs.dx:=port_num;
  178.  intr($14,regs);
  179. end;
  180.  
  181. procedure async_watchdog_off;
  182. var
  183.  regs: registers;
  184. begin;
  185.  regs.ah:=$14;
  186.  regs.al:=00;
  187.  regs.dx:=port_num;
  188.  intr($14,regs);
  189. end;
  190.  
  191. procedure async_warm_reboot;
  192. var
  193.  regs: registers;
  194. begin;
  195.  regs.ah:=$17;
  196.  regs.al:=01;
  197.  intr($14,regs);
  198. end;
  199.  
  200. procedure async_cold_reboot;
  201. var
  202.  regs: registers;
  203. begin;
  204.  regs.ah:=$17;
  205.  regs.al:=00;
  206.  intr($14,regs);
  207. end;
  208.  
  209. procedure async_set_baud(n: integer);
  210. var
  211.  regs: registers;
  212. begin;
  213.  regs.ah:=00;
  214.  regs.al:=3;
  215.  regs.dx:=port_num;
  216.  case n of
  217.   300: regs.al:=regs.al or $40;
  218.   1200: regs.al:=regs.al or $80;
  219.   2400: regs.al:=regs.al or $A0;
  220.   4800: regs.al:=regs.al or $C0;
  221.   9600: regs.al:=regs.al or $E0;
  222.   19200: regs.al:=regs.al or $00;
  223.  end;
  224.  intr($14,regs);
  225. end;
  226.  
  227. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  228. var
  229.  regs: registers;
  230. begin;
  231.  regs.ah:=$0F;
  232.  regs.al:=00;
  233.  if softtran then regs.al:=regs.al or $01;
  234.  if Hard then regs.al:=regs.al or $02;
  235.  if SoftRecv then regs.al:=regs.al or $08;
  236.  regs.al:=regs.al or $F0;
  237.  Intr($14,regs);
  238. end;
  239.  
  240. procedure async_get_fossil_data;
  241. var
  242.  regs: registers;
  243. begin;
  244.  regs.ah:=$1B;
  245.  regs.cx:=sizeof(fossildata);
  246.  regs.dx:=port_num;
  247.  regs.es:=seg(fossildata);
  248.  regs.di:=ofs(fossildata);
  249.  intr($14,regs);
  250. end;
  251.  
  252. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  253. begin;
  254.  async_get_fossil_data;
  255.  insize:=fossildata.ibufr;
  256.  infree:=fossildata.ifree;
  257.  outsize:=fossildata.obufr;
  258.  outfree:=fossildata.ofree;
  259. end;
  260.  
  261. end.
  262.